home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / parallax / more_exa.tar / more / gauss.p < prev    next >
Text File  |  1993-06-15  |  3KB  |  94 lines
  1. SYSTEM gauss_jordan;
  2. CONST n        = 5;
  3. TYPE  matrix   = ARRAY [1..n],[1..n+1] OF REAL;
  4.       line     = ARRAY [1..n] OF REAL;
  5.  
  6. CONFIGURATION  grid [1..n],[1..n+1];
  7. CONNECTION     up:  grid[i,j]  <->  grid[(i-1), j] .down;
  8.                row: grid[i,j]   ->  grid[i, 1..n+1].row; 
  9.                col: grid[i,j]   ->  grid[1..n, j].col; 
  10.  
  11. SCALAR a       : matrix;
  12.        a_l, b_l: line;
  13. VECTOR vmat    : REAL;
  14.  
  15.  
  16. PROCEDURE input (SCALAR VAR a : matrix);
  17. (* reading input for A and b from terminal *)
  18. SCALAR   i,j   : INTEGER;
  19. BEGIN
  20.   WriteString("Enter value of matrix A and vector b line by line :");
  21.   WriteLn;
  22.   FOR i := 1 TO n DO
  23.     FOR j := 1 TO n+1 DO ReadReal(a[i,j]) END;
  24.   END;
  25. END input;
  26.  
  27. PROCEDURE output (SCALAR VAR a,b: line);
  28. (* print results on terminal *)
  29. SCALAR i: INTEGER;
  30. BEGIN
  31.   WriteString("Solution:"); WriteLn;
  32.   FOR i := 1 TO n DO
  33.     IF a[i] = 0.0 THEN
  34.       IF b[i] = 0.0 THEN WriteString("equation system linear dependent");
  35.                     ELSE WriteString("equation system insoluble");
  36.       END;
  37.      ELSE WriteFixPt(b[i]/a[i],9,2);
  38.     END;
  39.     WriteLn;
  40.   END;
  41. END output;
  42.  
  43.  
  44. PROCEDURE elimination (SCALAR smat: matrix; SCALAR VAR a,b: line);
  45. SCALAR  i,num,diag           : INTEGER;
  46.         diag_el, el          : REAL;
  47.         ok                   : BOOLEAN;
  48. VECTOR  mat, sub, change1, change2,
  49.         first_el, top_el     : REAL;
  50. BEGIN 
  51.   LOAD(mat,smat);
  52.   FOR diag := 1 TO n DO
  53.     STORE[diag],[diag] (mat,diag_el);
  54.     IF (diag_el = 0.0) AND (diag<n) THEN  (* change lines *)
  55.       i := diag;
  56.       REPEAT
  57.         INC(i);
  58.         STORE[i],[diag] (mat,el);
  59.         ok := el <> 0.0;
  60.       UNTIL (i=n) OR ok;
  61.       IF ok THEN
  62.         num := i-diag;
  63.         PARALLEL
  64.           PROPAGATE.down^num (mat, change1);
  65.           PROPAGATE.up^num   (mat, change2);   
  66.           IF DIM1 = i    THEN mat := change1 END;   
  67.           IF DIM1 = diag THEN mat := change2 END; 
  68.         ENDPARALLEL
  69.       END;
  70.     END; (* diag_el = 0.0 *)
  71.  
  72.     PARALLEL
  73.       IF DIM2 = diag THEN
  74.         SEND grid.row(mat) TO grid.row(first_el)
  75.       END;
  76.       IF first_el <> 0.0 THEN mat := mat / first_el END;
  77.       IF DIM1 = diag THEN
  78.         SEND grid.col(mat) TO grid.col(top_el)
  79.       END;
  80.       IF (DIM1 <> diag) AND (first_el <> 0.0) THEN mat := mat - top_el END;
  81.     ENDPARALLEL;
  82.   END; (* for diag *)  
  83.  
  84.   STORE [DIM1],[DIM1] (mat,a);
  85.   STORE [*],   [n+1]  (mat,b);
  86. END elimination;
  87.  
  88.  
  89. BEGIN  (* main program *)
  90.   input(a);
  91.   elimination(a, a_l,b_l);
  92.   output(a_l,b_l);
  93. END gauss_jordan.
  94.